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SUMMARY 


An  altitude-error  display  for  height-finder  radar  has  been  developed  on  the  HP9000 
-  500-series  computer.  The  display  looks  like  an  ordinary  ray-trace  display  except  the  color 
of  the  rays  are  dependent  on  the  height  difference,  as  compared  to  a  standard  atmosphere 
for  the  same  elevation  angle  and  range. 


CONCLUSIONS 

Since  this  effort  only  considered  alternate  displays  of  well-established  ray-tracing 
theory,  no  attempt  was  made  to  validate  the  accuracy  of  any  of  the  resulting  displays. 

RECOMMENDATION 

The  altitude-error  displays  reported  here  should  be  incorporated  into  the  coverage 
diagram  of  the  Integrated  Refractive  Effects  Prediction  System  (IREPS). 
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INTRODUCTION 

Strong  ducting  conditions  occur  over  many  ocean  areas.  These  conditions  affect 
height-finder  radars  (such  as  the  SPS-48)  in  giving  accurate  target  positions.  Most  height 
finder  radars  calculate  altitude  based  on  a  standard  atmosphere.  When  ducting  conditions 
are  present,  large  errors  can  occur  between  the  calculated  and  the  true  target  height,  depend¬ 
ing  on  the  transmitter  height  and  the  target  range.  In  many  cases,  these  errors  are  greater 
than  50  percent.  A  height-finder  radar  altitude-error  display  has  been  developed  to  show 
the  amount  of  error  present.  The  display  looks  like  an  ordinary  ray-trace  display,  except 
the  color  of  the  rays  are  dependent  on  the  height  difference,  as  compared  to  a  standard 
atmosphere  for  the  same  elevation  angle  and  range. 

BACKGROUND  _ 

The  atmosphere  is  considered  to  consist  of  vertical  layers,  each  with  a  certain  gradi¬ 
ent  of  the  index  of  refraction.  The  layers  are  assumed  to  be  horizontally  homogeneous. 

Each  profile  consists  of  at  least  two  layers.  Each  layer  is  associated  with  a  height,  H(i),  and 
modified  refractivity  or  M-unit  value,  M(i).  Modified  rcfractivity,  M,  is  related  to  the  index 
of  refraction,  n,  by 

M  =  [n-l+f]  *  106 


where  a  is  the  mean  earth's  radius,  and  z  is  the  height  above  the  earth’s  surface. 

A  ray  path  under  standard  atmospheric  conditions  will  bend  downward  at  a  rate  less 
than  the  curvature  of  the  earth,  so  to  an  observer  stationed  on  the  earth’s  surface,  the  ray 
will  appear  to  bend  upward.  A  trapped  ray  is  one  that,  because  of  a  trapping  layer,  will 
bend  downward  at  a  rate  exceeding  the  curvature  of  the  earth.  A  trapping  layer  can  be  very 
easily  identified  by  a  negative  M-gradient.  Examples  of  profiles  that  represent  a  surface- 
based  duct  and  an  elevated  duct  are  shown  in  figure  1 .  Two  other  types  of  refraction  that 
describe  the  relation  between  modified  rcfractivity  and  height  arc  subrefraction  ami  super- 
refraction.  A  subrefractive  profile  will  cause  rays  to  be  bent  less  than  the  normal  or  stan¬ 
dard,  while  a  superrefraetive  profile  bends  rays  at  a  rate  exceeding  the  normal  but  not 
enough  to  cause  trapping. 

The  gradient,  Dmdh,  is  the  change  in  M-units  with  respect  to  the  change  in  height 
and  is  defined  as 


Dmdh(i) » 


M(i  +  1)  -  M(i)| 
IKi  +  1)  -  H(i)j* 


Table  1  shows  the  relation  between  the  M-gradient  and  the  different  types  of  refraction. 
Figure  2  gives  a  clear  picture  of  the  relative  bending  among  the  different  types. 

An  individual  ray  trace  begins  with  an  elevation  angle  specified  at  the  source  height, 
Ht,  and  consists  of  a  scries  of  calculations  to  determine  ei*;  r  *  r>*  a  specified  range  or 

range  at  a  specified  height.  All  calculations  can  be  described  by  one  of  the  following  s»:< 
cases.  The  variables  are  defined  as 
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Figure  t.  Exa/nples  of  elevated  and  surface-based  ducts  from  elevated  layers. 


Tabic  1 .  The  relation  between  M-gradicnt  and  the 
different  types  of  refraction. 


Types  of  Refraction 

M -Gradient 

Trapping 

<  «  0  M/km 

<  <*  0  M/kft 

Supcrrefraciivc 

0  to  79  M/km 

0  to  24  M/kft 

Standard 

79  to  157  M/km 

24  to  48  M/kft 

Subrcfraclivc 

>157  M/km 

48  M/kft 

«  3  elevation  angle  at  beginning  of  calculation  (rad) 
a' s  elevation  angle  at  end  of  calculation  (rad) 
h  82  height  at  beginning  of  calculation  (m) 
h'  °  height  at  end  of  calculation  (rn) 
r  «  range  at  beginning  of  calculation  (km) 
r*  a  rajlge  at  end  of  calculation  (km) 

Case  1 :  a  >  0,  h'  known  (figure  3) 

o'  «  7e?+  2  •  KT3  Dmdh(i)  (h*  -  h)  ,  if  H(i)  <  h  <  h’  <  H(i  +  1 ) 

Dnuih(i) 

If  the  source  is  in  a  duct,  trapping  may  occur  for  some  initial  elevation  angles.  In  this  case, 
the  ndicaml  for  a'  becomes  negative,  and  h*  readies  a  maximum  hciglit.  For  example, 

a*  **  0  . 


r' 


a 

Dmdh(i) 


,  and 


h’  =  h  - 


-» 

a“ 


2  •  10"3  Dmdli(i) 


3 


1+1 


Figure  3.  Ray  trace  variables  for  ft>  0. 

Case  2:  a  >  0,  r'  known  (figure  3  applies) 

a'  =  a  +  Drodh(i)  (r’  -  r)  .  if  h  <  H(»  +  1 ). 

h'«h  + - 2^= - 

2  •  10~3  Dnulh(i) 

Case  3 :  or  <  0.  h*  known  (figure  4) 

a  «  -  /ft2  «■  2  •  l(T3  Dmdh(i)  (h*  - h)  ,  if  H(i ♦  l)>h>h*>H(i). 


r'  B  r  + 


or  -  a 

Dmdh(i) 


A  ray  that  is  initially  downgoing  may  eventually  become  upgoing  as  ot  increases.  The  ray 
reaches  a  minimum  height,  and  in  this  case,  the  radicand  for  a'  becomes  negative.  Therefore, 

ft'°0  . 


r  “r- 


a 


Dindh(i) 

f 


h’  “li¬ 


ft* 


2  •  1Q~3  Dmdh(i) 

Case  4 :  ft  <  0.  r’  known  ( figure  4  applies) 


a’ «  ft  ♦  Dmdh(i)  (r*  -  r)  .  if  h’  >  M(i). 
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Figure  4.  Ray  trace  variables  for  Of  <  0. 


h'  =  h  + 


2 

o f  *  -  or 


2  •  10~3  Dmdh(i) 


Case  5:  a  “  0 

If  Dmdh(i) "  •  0,  use  Case  I  or  Case  2  as  appropriate. 

If  Dmdh(i)  <  0,  use  Case  3  or  Case  4  as  appropriate. 

Case  6;  A  ray  launched  at  the  inflection  point  (figure  5)  with  ot a  0  will  stay  at  that  height. 


PROGRAM 

The  program  plots  height  vs.  range  for  each  ray.  Reflected  rays  are  not  traced.  Each 
ray  is  drawn  in  several  colors,  depending  on  the  error  scale  chosen  by  tire  user. 

Initially,  there  are  four  options  available  to  the  u$cr:{  1) delete  data  filc.(2)add  data 
file, (3  )cdit  data  file,  and  (4  )run  the  program  for  a  display.  If  option  4  is  picked,  a  list  of 
available  data  files  will  appear  on  the  screen.  After  a  data  file  has  been  chosen,  there  are 
several  parameters  the  user  must  enter  into  the  program: 

1 .  Maximum  height  for  the  display  in  feet  or  meters 

2.  Maximum  range  for  the  display  in  nautical  miles  or  kilometers. 

3.  Antenna  height  in  feet  or  meters. 

4.  Lower  elevation  angle.  Lower  angular  limit  in  milliradians. 

5.  tipper  elevation  angle.  Upper  angular  limit  in  milliradians. 

6.  Number  of  rays.  This  is  the  number’  of  rays  to  be  traced. 
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Figure  5.  Breakpoint  at  A, 

7 .  Error  scale.  The  height-error  scale  can  be  an  absolute-  or  percent-error  scale, 
indicated  by  entering  “A'*  or  “F\  The  default  is  “A”. 

8.  Error  increment.  This  value  determines  the  scale  by  which  the  eolors  are  de¬ 
fined.  If  using  an  absolute-error  scale,  the  error  increment  is  entered  in  feet  or  meters. 

Normal  output  for  the  display  is  the  screen,  but  a  hardcopy  print  can  be  selected. 

Once  the  data  has  been  read  from  the  selected  file,  the  program  performs  a  linear 
extrapolation  to  find  the  M-unit  value  at  the  surface  and  at  the  maximum  plot  height,  if 
necessary.  These  values  are  added  to  the  height  and  M-unit  arrays  and  the  gradients  (Dmdh) 
are  then  calculated, •  The  initial  launch  angles,  calculated  from  the  lower  elevation  angle, 
the  upper  elevation  angle,  and  the  number  of  rays,  are  algo  put  into  an  array. 

The  ray  trace  is  performed  by  range  increments  { 1  /SOth  of  the  maximum  plot  range) 
i.e..  beginning  with  the  initial  launch  ngle  and  antenna  height,  a  new  angle  and  height  are 
calculated  to  a  specified  range,  plotted,  the  range  is  incremented,  the  next  angle  and  height 
are  calculated,  plotted,  and  so  forth  until  the  maximum  height  or  maximum  range  has  been 
readied.  As  each  new  angle  is  calculated,  the  program  will  branch  to  the  appropriate  case 
(as  discussed  in  the  previous  section).  With  each  new  height  calculated  the  program  will 
trace  a  ray  to  the  same  range  using  the  same  initial  launch  angle  for  a  standard  atmosphere. 
The  difference  between  the  two  heights  gives  the  height  error,  and  the  ray  will  be  dr„wn  in 
the  appropriate  color. 

If  the  antenna  height  is  at  a  breakpoint  where  Dmdh  is  positive  beneath  the  point 
and  negative  above,  the  program  will  calculate  through  an  infinite  number  of  maximum*  and 
minimum*  for  sufficiently  small  initial  launch  angles,  resulting  in  a  complete  halt  of  the 
program.  Also,  because  of  the  dot-matrix  screen,  some  height  increments  may  be  too  small 
to  be  noticed  in  plotting,  and  wlrat  the  program  calculates  as  maximums  and  minimurns 
may  look  like  a  straight  line  across  the  screen.  Therefore,  a  restriction  on  the  initial  launch 
angles  is  made.  Depending  on  the  angular  limits  used,  the  program  will  trot  allow  traces  of 


•To  avoid  Dmdh  apptoachiftg  reto.  a  value  of  JOe-6  was  assigned  to  Dmdh  if  it  fell  in  the  region  -lOc-6 
<  Dmdh  <  10e-6. 


ft 


rays  launched  within  a  certain  angle  above  and  below  the  horizontal.  A  single  horizontal 
ray  trajectory  is  drawn  for  launch  angles  within  this  range  and  the  next  greater  angle  in  the 
launch  angle  array  is  selected  upon  completion  of  this  ray  path. 


SAMPLE  DISPLAYS 

Figure  6  shows  a  height-finder  radar  altitude-error  display  for  an  elevated  duct. 
Figure  7  shows  two  ray-trace  diaphys,  one  for  a  standard  atmosphere  (black  rays)  and  one 
for  the  same  elevated  duct  (red  rays).  The  height  difference  calculated  for  a  specific  range 
between  the  two  sets  of  rays  is  shown.  The  middle  ray,  launched  at  zero  radians,  is  refrac¬ 
ted  the  most  and  therefore  produces  the  most  error.  This  can  also  be  seen  in  figure  6  where 
the  red  area  (for  the  shortest  range)  is  associated  with  rays  launched  near  zero  radians. 

The  program  does  not  distinguish  between  height  difference  above  or  below  the 
standard.  For  instance,  at  a  height  of  10,000  feet  and  a  range  of  100  miles,  one  may  get  an 
error  of  1000  feet,  which  could  be  1000  feet  above  the  standard  or  1000  feet  below  the 
standard.  As  can  be  seen  in  figure  8,  the  ray  at  -10  mrad  bends  above  the  standard  then 
crosses  over  to  bend  below  (rays  in  standard  atmosphere  are  in  black).  Again,  the  middle 
ray  at  zero  radians  gives  the  highest  error.  The  error  display  is  shown  in  figure  9.  The 
error  display  for  the  same  profile  using  200  rays  is  shown  in  figure  10.  In  displays  such  as 
this,  one  can  see  rays  increasing  in  height  error  (as  well  as  height  and  range),  then  starting  to 
decrease  in  error.  Figure  8  shows  why  this  is  so. 

Another  example  of  this  type  of  display  is  shown  in  figure  1 1  with  the  correspond¬ 
ing  ray  trace  shown  in  figure  1 2.  In  figure  1 1 ,  the  first  ray  is  reflected  amd  therefore,  not 
traced.  From  the  third  ray  on,  tire  rays  bend  toward  the  standard  to  produce  a  decrease  in 
height  error,  lire  “full**  error  display  (using  200  rays)  is  shown  in  figure  1 3. 

Although  the  error  displays  are  meant  to  be  used  for  surface  height-finder  radars, 
figures  6  and  10  are  displays  for  airborne  height-finder  radars  and  are  shown  only  for 
demonstration  purposes. 
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Figure  7.  Hay-trace  display  (or  elevated  duct  o(  figure  6  (red)  and  standard  atmosphere  (black). 
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figure  8.  Ray-trace  display  (or  elevated  duct  (red)  and  standard  atmosphere  (black). 
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Figure  9.  Error  dltpijy  lor  elevated  duct  of  figure  8  -  five  ray*. 
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Figure  11.  Error  ditpUy  (or  uirlKc-fcuad  duct  -  five  rayi. 
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F iqure  1 2.  Ray-tract  display  lor  surfact-bastd  duct  of  fiftur*  1 1  (rtd)  and  standard  atmospfccrt  (black). 
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CONCLUSIONS 


A  height-finder  radar  altitude-error  display  has  been  developed  on  the  HP9G00  — 
500-series  computer  based  on  traditional  ray-tracing  concepts.  This  display  shows  altitude 
error  compared  to  a  standard  atmosphere  using  a  color  scale  superimposed  on  a  traditional 
altitude-versus-range  ray  trace  for  arbitrary,  piecewise,  linear  refractivity-versus-altitude 
profiles.  Since  this  effort  only  considered  alternate  displays  of  well-established  rav-tracing 
theory,  no  attempt  was  made  to  validate  the  accuracy  of  any  of  the  resulting  displays. 


RECOMMENDATION 

The  altitude-error  displays  reported  here  should  be  incorporated  into  the  coverage 
diagram  of  the  Integrated  Refractive  Effects  Prediction  System  (IREPS). 


APPENDIX  A:  COMPUTER  PROGRAM  USTING 


At 
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1  :  c 
2:c 
3  •'  C 
4 :  c 
5 :  c 

6  :  c 

7  '•  C 

8  :  C 

9  :  C 
1  0:C 
1  1  -  C 
1  2 :  C 

13  c 
1  4  :  C 

1  5  :  C 
16  c 
1  7  :  c 
18  c 
1  9  :  C 
20. e 

21  :c 

22  ;  c 

23  :  C 

24  :  C 
2S:c 
26:c 

27  :C 

28  :c 

29  :c 
3  0  :  C 

31  c 

32  '•  c 

33  t 

34  :C 
35 :  c 

36  C 

37  c 

38  c 

39  c 

40  c 

41  c 

42  :c 

43  :  C 

44  :  c 

♦Sc 

46  C 

47  c 

48  -C 

49  :  C 
SO :  C 
51  c 
S2c 
S3: 
S4: 
55 
56: 


**************  Variables  used  in  program  ********************** 


dsdh : 

erropt  •• 

aber : 
per ; 
fildes: 
index : 

mvfl  : 


ht  : 
hmax  : 
rmax  : 
orh: 

ora: 

h: 

i«. 

plot : 

naae  - 

nl  vl ; 

ilvi : 

a: 


f  7  : 

angle; 
hun ; 

reun : 

fret iae : 

•or : 

•Ob: 

fret 

ipro_prlnt  •• 
twice: 


35  element  array  containing  the  gradients  of  the 
profile. 

Character  string  indicating  if  absolute  ('a'  or  *A') 
or  percent  ('p'  or  *P*)  for  color  scale  uas  chosen. 
Absolute  error  increment  in  meters. 

Percent  error  increment. 

File  descriptor  for  starbase  graphics  routine. 

Integer  indicating  color  to  be  used  for  plotting 
(1-7) . 

Logical  flag  indicating  when  to  move  to  the  next 
height-range  point  for  plotting  onto  hardcopy  when 
changing  pen  colors. 

Antenna  height  in  meters. 

Maximum  height  for  plot  display  in  aeters. 

Maximus  range  for  plot  display  in  kilometers. 

33  element  array  containing  heights  of  the  original 
profile. 

33  element  array  containing  m-units  of  the  original 
profile . 

35  element  array  containing  heights  of  the  new 
profile. 

Counter  Indicating  what  color  is  currently  being  used 
for  hardcopy  plotting. 

Logical  flag  Indicating  if  plotting  onto  hardcopy, 

(T— plot , P-don't  plot). 

Character  string  containing  the  data  filename  to  be 
read. 

Number  of  new  levels  after  extrapolation  to  the 
surface  and  maximum  height. 

Number  of  levels  in  the  original  profile. 

33  element  array  containing  m-units  of  the  new 
profi It. 

Character  string  indicating  If  'AUTODUMP*  is  set  to  on 
or  off. 

Array  containg  initial  elevation  angles  (300  maximum). 
Character  string  Indicating  what  height  units  the 
profile  was  stored  in. 

Character  string  indicating  if  refract ivity  values 
were  stored  in  s-units  or  n-units. 

Logical  flag  indicating  first  height-range  point 
calculated  for  new  ray. 

Starting  range  for  hardcopy  plotting. 

Starting  height  for  hardcopy  plotting. 

Logical  flag  indicating  first  storage  of  height-range 
point  for  interpolat ion  between  color  transitions. 
Integer  Indicating  type  of  profile  printout  for 
hardcopy;  1 -graph,  2-number. 

Logical  flag  indicating  if  program  has  been  run  at 
least  once. 


common/errvar/dmdh(3S) , erropt , aber , per, f i Ides, index ,mvf 1 , 
♦ht , hmax , r»i», rine,orh(33) ,orm( 33) ,hi35) , i a. plot , name, 
♦nlvl,iivl,m,f7, angle ( 300 1 , hun, reun, f rst iae, tor, soh, frst , 
♦ipro_j>rint  .twice 
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57;  integer*4  fildee^index 

58:  real  mC35) 

59:  character^  f7 

60:  character*^  erropt > hun, reun 

61 :  character*14  naae 

62:  logical  mvfl , plot , fr*t iae, fr*t , logical , twice 


A*4 
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4  :  C 

c  .  r 

for 

ray  tracing. 

3  •  w 

6  :  C 

Glossary : 

7:C 

opst 

Character  string  indicating  if  tha  'option'  or 

8 :  C 

'backup'  key  was  hit. 

9  •  c 

outst 

Character  string  variable. 

1  0  :  C 

optn 

Real  value  of  option  nusber  chosen  by  user. 

11c 

ioptn 

Integer  value  of  option  nusber  chosen  by  user. 

1 2 :  C 

flag 

Logical  flag  indicating  if  tha  user  has  gona 

1  3  :  C 

through  tha  edit  routine. 

1  4  :  C 

profile 

Array  containing  all  data  fllanases. 

1S:C 

ifil 

Nusber  of  data  filenaats  in  profile. 

16  c 

rpick 

Real  valua  of  nusbar  of  anvlronsantal  data  fila 

1 7  :  C 

chosen. 

1  8 :  C 

ipick 

Integer  value  of  nusber  of  environsental  data  fila 

19  c 

chosen . 

£0:e 

rlowea 

Lower  elevation  angle  in  srad . 

21  :c 

upea 

Upper  elevation  angle  in  srad. 

22  :c 

rplot 

Nusber  of  rays  to  ba  plotted. 

23  :c 

irplot 

Integer  value  of  nusber  of  rays  to  be  plotted. 

£4 

£5 

£6 

27 

£8 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 


***********************  PROGRAM  HFERR  *************************** 

Purpose : 


progra*  hferr 

include  '/uar/inciude/atarbasa. ft .h‘ 
include  '/usr/inciude/starbast . f2.h' 
•INCLUDE  ‘ trrvar' 

characters  fun 
characters  opst.kgt 
charaeter*i4  profileiSQ) 
character* 1 6  dspfr* 
character*#!)  dussy.outat 
int#g#r*4  tt#tu« 
logical  flag, duct ,us_f lag 
lr«5 
iw«6 


40 

41 

42 

43 


44 

45 

46 

47 

48 

49 

50 

51 

52 

53 


54 

55 

56 


call  fcyinitUr,  iw,  15) 
twice*  falsa . 
ua_f lag*. falsa. 
ipro,j)rint*0 

•«*«*o****  Clear  alphanumeric*  scraan  and  write  options  list.  ****** 
10  call  kyCrsor! 0, 0, -I ) 

write! iw, '( “1  --  Delete  an  environaental  data  file*)') 
wrl  tel  i  w,  '  ( *2  —  Add  an  env  i  ronsent  al  data  file*)*) 
wr i tat iw, * ( *3  —  Edit  an  anvlronaantal  data  file*)*) 
write! Iw, * t "4  —  Altitude  Error  Display*)'! 
ifttwlca)  write! lw, ' C *S  --  Display  for  ease  profile*)') 
write! iw, • ) 

call  kyenter t *opt ion  nusber  tor  ’end*)  * , 0, i . , S . , -1 . , optn, opst ) 
»fl iopst .  eq  'backup' ) .or. (opst .  eq . 'option* ) )  goto  10 
write! iw,*) 
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S7 .  i opt n*nint ( optn ) 

58:  if ( ioptn. eq. 4)  twice® . false . 

59  i f 1  opt  ion . eq. -1 )opst*' end ' 

60-  if t (opst . eq. ' end* ) . or . (opst . eq . 'END' ) >  then 

61  ;  goto  20 

62:  else 

63:  if (. not .twice)  call  renew 

64:  end  if 

65 :  30  flag®  false . 

66:  if ( < ioptn . eq . 1 ) . or . ( ioptn . eq . 2)  or . ( ioptn . eq. 3) >  then 

67-  call  edit < ioptn, opst , flag# iw) 

68:  if ( (opst . eq .' opt  ion* 1 . or .( opst . eq . 'backup* ) )  goto  10 

69:  end  if 

70:  if(flag)  goto  10 

71:  i f ( ioptn. eq . 5)  then 

72 :  us^f lag® , true . 

73:  call  put  in(r  1 ,  ro(  irplot ,  f  i  War,  fun) 

74;  goto  15 

75:  end  if 

76  :c 

77  c  **#**•**■*••**  List  existing  environmental  data  files.  ****•*♦<***•• 

78:  C 

79  call  lsfi les< ' .prof ' .profile, if  ill 

80-  ift ifi 1 .eq. 0>  then 

81  write! iw. ' (al > * >char<7) 

88  call  kyat ent * “ee  No  data  files  exist.  Press  'RETURN'  to  create 

83  ♦  new  file.  ' .outst .opst ) 

84  ifi (opst  eq. 'backup' » .or. (opet .eq. 'option' J )  goto  10 

8$  ioptn*2 

86  goto  30 

87:  end  if 

ee  writeliw.*) 

89  e 

90  e  *#•**«***•**  Begin  writing  prompt  strings  for  user  input.  •****•*•* 

91  -  c 

92  40  call  hyenter 1 *nueber  of  environmental  data  file  " , 0. 1 . , real 1  if  1 1 ) , 

93  *0 . , rp  j  cV , opst  1 

94  l  f (  1  opst  , eq  ’ backup ' )  or  ( opst  . eq  'optlon* 11  goto  10 

95  ipick«nint (rpick) 

96  namevprof i 1 e< ipick 1 

97  wr i tel iw, • ) 

98  50  call  feyenterf'maximue  height  for  display  1 . 1  S0Q00 0  .  ,hma* . 

89  *Opst  > 

100  if (opst  eq. 'backup' l  goto  40 

tOt.  i f( opst . eq. 'opt  ion’ >  goto  10 

10£:  wr Itel iw, *  > 

103:  60  call  kyentert ‘max imum  range  for  display *, 2 , 20 ., 1 000 ., 0 . ,rma* , 

104:  *opst 1 

1  OS  iftopst.eq  'backup'}  goto  50 

106.  i f 1 opst . eq .' opt  ion* 1  goto  10 

1  07  ■  write! iw, *> 

lOe  70  call  kyenterfantenna  height ",  t ,  t  .  ,50000 0 .  ,ht ,  opat  1 

109  i f< opst. eq' backup ' )  goto  60 

110  iftopst  eq  'option'!  goto  10 

111  wr i t  e( iw , * } 

1  12  80  call  kyenter(*lower  elevation  angle  in  mrad* , 0.-1 00 . , 1 00  , 1 01 . , r  1 , 
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113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121  : 
122: 
123: 
124: 
125: 
126  : 
127: 
128: 
129: 
130: 
131  : 
132: 
133: 
134: 
135: 
136: 
137: 
138: 
139: 
140: 
141  : 
142: 
143: 
144: 
145: 
146: 

1  47 :  C 
1  40  :  r. 
1  49  :  C 
i  5  0  ■'  C 

is;  • 

1  52 :  C 
1  53 :  C 
1  54 ;  c 
1 55 :  c 
156: 
157: 
158: 
159: 
160: 
161  : 
162: 
163: 
164: 
165: 

1  66 : 
157: 
168: 


+Op5t  ) 

if (opst . eq . 'backup' )  goto  70 
if (opst .eq. 'option  )  goto  10 
wr ite( iw, * ) 

90  call  kyentert  "upp*>f  elevation  angle  in  rorad" . 0, -1 00 . , 1 00 . , 1 01 . , ru, 
+opst ) 

i  f (opst . eq . 'backup' )  goto  80 
i f (opst . eq . 'opt ion' )  goto  10 
write( iw,*) 

100  call  kyenter(  "number  of  rays  to  be  plotted" , 0, 1  . ,300 0 rplot , 

+  opst ) 

if (opst .eq, 'backup' )  goto  90 
if (opst .eq. 'option' )  goto  10 
irplot*nint (rplot ) 
write( iw,*) 

110  call  kystent("A  or  P  for  absolute  or  percent  error" , 0 , ' A, a,P ,p ' , 

+' a ' , erropt , opst ) 
i t ( opst . eq . 'backup ' )  goto  100 
if (opst . eq . 'option' )  goto  10 
wr ite( iw, * ) 

i f ( ( erropt . eq . ' a ' ) . or . ( erropt . eq . ' A ' ) )  then 
120  call  kyentert “number  for  *;rror  increment  “,  1  ,  1  ., 5000  .,  0  .,  aber , 
+opst ) 

if (opst . eq . 'backup' )  goto  110 
if (opst .eq. 'option' )  goto  10 
writeUw,*) 
else 

130  call  kyentert "percent  error  increment ",  0, 1 80 . ,5 per ,opst ) 
if (opst 'backup' )  goto  110 
if (opst .eq. 'option' )  goto  10 
write ( i w, * ) 
end  i  f 

call  recddal i pick, prof ile,hun,reun) 

15  call  kyread(7, f 7 ) 

********•,<»  Call  INITIAL  to  set  up  arrays  and  variables  used  in 
the  ray  tracing  subroutines.  *************o************»****** 

call  initial (rl,ru,i rplot ,duet , forbid) 


**********  Call  GRAPH  to  initialize  graphics  screen  and  draw  axes 
for  plot!  ing.  ***,•.*******************************•****•*********• 


call  kyread(6, kgt ) 

i f ( ( ipro_print . eq. 2) . or . ( ipro_print . eq . 1 ) )  kgt* 'on' 
if (kgt .eq. 'off' )  then 
plot* . false . 

else  i f ( kgt . eq . ' on' )  then 
plot* .true . 

if ( ( ipro_print .he. 1 > .and. ( ipro_print . ne.2) )  then 

call  kyentert "prof! le  printout:  1  -  graph  ;  2  -  numbers", 
+  o,  1 .  ,2. ,  1  . , preprint, opst ) 

ipro_print*nint  ( p*  o_print  > 
end  i  f 
end  if 

25  call  graphtrl , ru, irplot > 
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1  69  :c 

170  :c 

171  :  c 
17£: 
173: 

1  74  :  C 
n  5  :  C 
176:C 
177: 
178: 
179; 
180  ; 
131  . 
182: 
183: 
184' 
185: 
186  : 
137: 
188: 
169: 
190- 
191  ; 
192: 
193: 
194: 
195: 
196: 
197: 


********************  Start  of  main  calculations.  **************** 

call  actapp< irplot , duct , forbid) 
urit#( iw,*) 

************************  Begin  dump.  **************************** 

status*gclose( Filde*) 
twice* .true . 
if(plot)  goto  10 

call  kystent (  "Free*  * AU1ODUMP-0N '  and  'RETURN'  for  hardcopy**, 
<~1,'*','  ' , outst , op*t 1 
i f ( opst . eq . ' opt  ion ' )  goto  10 
call  kyreadC 6 , kgt  ) 
i f ( kgt . eq . ' on ' )  then 

call  kyenterv "prof i le  printout:  1  ~  graph  ;  2  -  numbers", 

♦  0 , 1 . ,2. . 1 . ,pro_print , opst ) 

if  Copat .eq. 'option* )  goto  10 
ipro_print*nint  Cpro_print ) 
plot*  true . 
goto  25 
else 

goto  10 
end  if 
cont inue 

if(ua„flag)  call  ayatemC'rm  uain'l 

call  fcytera 

end 


£0 
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1 : c  *************************  SUBROUTINE  ACTAPP  ************************ 

2 :  C 

3 : c  Purpose;  Thi*  begins  the  main  locp  of  the  program.  It  checks  for 
4:c  the  transmitter  height  level  and  begins  the  ray-tracing 

5 : c  subroutines. 

6  :  C 

7 :  c  Glossary: 

8  :  C 

9 :  c  duct  Logical  flag  indicating  if  th*  transmitter  height  is 

1 0 : c  at  a  break  point. 

11 :c  irays  Number  of  rays  to  be  used  in  plotting. 

1  2 :  c 

1 3: c  ******************************************************************* 

1  4 :  C 

15:  subroutine  act appf irays , duct , forbid ) 

1 6 : $  1 NCLUDE  ' errvar ' 

17:  logical  duct 

1  8  :  C 

1 9 : c  *******  Check  what  level  the  transmitter  height  is  at.  ************* 
20:  c 

£1 :  do  i x»1 ,  nl  vl 

22:  i f ( ( h( i x ) . 1* .ht ) . and . (ht . 1* . h( ix+1 ) ) )  goto  40 

£3  end  do 

24:  40  continue 

ES:c 

26:c  ****************  Begin  main  loop.  *********************************** 

£7 :  c 

28.  im*1 

29  if (plot  )  then 

30:  C«H  seven  irays, duet ,  forbid,  ix  ) 

31;  else 

32  call  regular! irays. duct , forbid, ix ) 

33 ;  end  1 f 

34.  return 

3S :  end 

36  c 

37c  •*•**•••***••••**•***  SUBROUTINE  STAND  *•••••*••**•***♦•*•**0***** 

36:c 

39  c  Purpose;  This  routine  performs  a  ray  trace  for  a  standard  atmos- 

40  c  phere.  It  begins  at  the  transmitter  height  and  traces 

41  c  to  the  specified  range  given  by  the  current  non-standard 

atmosphere  being  used  with  the  same  initio!  elevation 
*3;c  angle. 

44  :c 

45 :c  Glossary ; 

46;c  hs  Height  traced  to  at  range  rp . 

47c  hdif  Difference  in  height  between  the  ray  traced  in  a  staiv* 

4®  c  dard  atmosphere  and  that  traced  in  a  non-standard  atnos- 

49  ;c  phere  at  the  same  range. 

50  sc 

51c  ••••**********ee**e*ee**e»ee*ee**ee*ee**e**e*ee**e«*e**e**e**e**e» 

52  c 

53:  subroutine  standif ixang.rp.hp) 

54. • INCLUDE  'errvsr ' 

55:  rf«rp 

56:  rbef*0. 


A-9 


Oct  01  08:25  1986  /t a/»oll y/st array . dr/act app . f  —  printed  on  Oct  01  1986  Pag< 


57;  hbaf«ht 

58:  alpha»fixang 

59 :  c 

6 0 : c  ************  Bogin  tract  for  down-going  rays.  ********************* 

61  :  C 

62:  if ( alpha . It . 0 . )  than 

63:  alphap»alpha+1 . 1 8#-4*rf 

64:  if (alphap.ga. 0. )  than 

65:  alphap*0. 

66:  rang*»rbaf-alpha/1 . 1 8a-4 

67=  hs«hbaf-alpha**2/2 . 36t-7 

68=  alpha*alphap 

69:  hbtf*hs 

70:  rbef«ranga 

71  :  goto  1  0 

72:  and  if 

73  ••  hs*hbof+(  «lphap*'*2-alph***2)/2.36*-7 

74  :c 

75 : c  *******  if  tha  haight  is  nagativa,  than  ray  is  rafiactad.  ********* 
76 :  c 

77:  if (hs. It . 0. )  than 

78 ;  alph«p»-SQRT<  alpha**2+2 . 36t-7* (-hbtf ) ) 

79 :  ranga»rbaf+( alphap-aiphs)/1 . 16t-4 

80:  alphap*-alphap 

81 :  alpha»alphap 

82:  rbaf«r*ng* 

83:  hbaf»0. 

84:  goto  10 

85 :  and  i f 

86:  goto  20 

87:  and  if 

68  :c 

89 ; c  *•••****••**  Bagin  tract  for  up-going  rays.  *••*•****•**•****•**• 

9  0  :  C 

91:  io  if (alpha. go. 0.  )  than 

92 :  alphap*alpha*1 . 1 8*-4* ( rf -rbaf > 

93 :  h**hbaf*(aiphap**2-alpha**2)/2.36t-7 

94;  and  if 

9$:  20  continut 

96;  hd i f «ABS( hp-hs ) 

97  :c 

96-c  *#•••••*•***  Calling  routint  to  datsrsina  color  according  to  arror 

99  c  incraatm  scala.  •**•**•••••••****•*•**••••*•***••«••••*****•***• 

1  0  0  :  C 

101:  rng«0 . 

102:  hyt«0. 

103  c 

104:  call  inttrpol (hdi f .rp.hp.rng.hyt ,hs) 

105:  frst*. falsa, 

t  06 ;  if (plot  >  than 

107:  call  stapf ixplt (hdi f ,hs ,rp,hp ,rng,hyt ) 

108:  alsa 

109:  call  stapf i xscr(hdif ,h*,rp(hp(rng,hyt ) 

110:  and  if 

111:  raturn 

112:  and 
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3 :  C 

Purpose  •• 

This  routine  performs  a  ray 

4’ C 

S:c 

Glossary : 

6  ’  C 

7:C 

rbef 

Range  before  calculation. 

8 :  C 

rp 

Range  after  calculation. 

9  ’  C 

rinc 

Range  increment. 

1  O’C 

hbef 

Height  before  calculation. 

11  :C 

hp 

Height  after  calculation. 

1 2 :  C 

ij 

Height  level  counter. 

1 3 :  C 

alpha 

Angle  before  calculation. 

1  4  ’  C 

alphap 

Angle  after  calculation. 

15 

16 

17 

18 
19 
£0 
£1 
22 
£3 
24 
£5 
26 
£7 
28 
£9 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 
49: 
SO’ 

51  •• 

52  t 
S3: 
S4: 
55: 
56  = 


*********************  SUBROUTINE  DOUN  ***************************** 

trace  for  down-going  rays. 


****** **************** *•******•*****•»••**«• ****************** ****** 


c 
c 
c 

•OPTION  ONEYRIP 

sub rout in*  down (alpha, hbef , i j , rbef , rp, hp, f ixang ) 
include  Vuar/include/starbas*. f 1 .h' 
include  '/usr/include/«tarbase . f£.h' 

•INCLUDE  ' errvar* 
c 

c  •**••*******•*•  Begin  loop  to  trace  fro*  transmitter  height  to  the 
c  first  level  or  until  a  minimum  has  been  reached.  •*••*•**•••*••*•**** 


do  uhi let ( i i . ge . 1) . and. (alpha . la .0. ) ) 
rp«rbef erinc 
iHrp.ge.rmax 1  goto  10 
alphap«alpha«-dadh(  i  j  )e(rp-rbef ) 


has 


i***«*«**  if  the  new  angle  calculated  is  positive  then  a  minimum 
been  reached.  ALPHAP  is  set  to  0.  •***•♦*♦**•♦•**•***•**••*•** 


then 


if (alphap . ge . 0 . ) 
alphap«0. 

rp«rb*f-alpha/d*dh( i j > 
hp«hbef ~alpha**2/£ . e-3/dmdhi 1 ) ) 
end  i  f 

hp«hbef ♦( alph*p**2-alph**e2}/2. e-3/dadh( i J ) 
IMhp.lt  hd  j  >>  then 
hp«b( 1 J ) 

rad«alph***2*2.e-3*d*dh( 1 j )*(hp-hb*f ) 


«*•••••*•«**  if  pad 
ALPHAP  is  set  to  0. 


is  negative  then  a  minimum  has  been  reached. 


then 


i  f (rad .  le . 0 .  ) 
alphap*Q . 

rp«rbef-alpha/dmdh( i J ) 
hp»hbef-alpha**£/2 .e-3/dmdh( i J  > 

else 

alphap»-SQRT( rad) 
rparbef+(alphap-alpha)/dadh( i j ) 
end  if 
i  )*i j-l 
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57;  end  if 

58  .c 

59  ;c  *********  Once  a  specific  height  end  renge  have  been  calculated 
60:c  subroutine  STAND  is  called  to  calculate  the  height  at  the  sane  range 
61 :c  RP  for  a  standard  atmosphere.  ************************************** 
62  :c 

63;  i f ( rp . ge . rmax )  goto  10 

64:  call  standlf ixang>rp,hp) 

65;  rbef«rp 

66;  hbef*hp 

67:  alpha*alphap 

68:  if ( alpha . eq. 0 . )  goto  10 

69  ••  end  do 

70:  ifCij.eq.0.)  goto  30 

71  :  c 

72 ; c  ************  Trace  to  exactly  the  aaxiaun  range.  ****************** 

73  :c 

74:  10  if ( rp . ge . raax )  then 
75:  rp-rsax 

76  :  alphap«alpha*d*»dh(  i  j  >*(rp-rbef  ) 

77  hp*hbef+( alphap**2-alpha**2>/2 .e-3/dadM i J ) 

78:  call  standi flxangj rp.hp) 

79:  end  if 

80;  30  return 
81 :  end 
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1  :c 
2 :  C 
3  '•  C 
4 :  C 

5  : 

6: 

7  ’• 

8: 

9: 

10: 
ire 
1  2  :  C 
1 3  ;  c 
1  4  :  C 
15: 

16- 

17: 

18; 

19: 

20: 

21  • 

£2: 

23: 

24: 

25: 

26: 

27: 

28: 

29: 

30:  20 

31  :  C 

32  c 

33  c 

34  :  C 
3$ : 

36: 

37: 

38: 

39: 

40 

41  : 

42: 

43: 

44  : 

4S: 

46: 

47  : 

48: 

49: 

50: 

51 

52 

53 

54  10 
SS: 


********************  SUBROUTINE  EDIT  **************************** 

This  subroutine  performs  ell  the  editing  operations  of  the  prograa 

subroutine  edit ( ioptn,  opst , f lag, iw) 
charact#r*8  opst.outst 
charact#r*14  f i l*n*(50) , duanaae 
charect#r*80  due 
logical  flag 
flag* .true . 

**************  Specified  files  ere  deleted  or  put  into  the  vi 
editor  for  editing.  ************•******************'.********* 

if ( ( ioptn . eg , 1 ) . or , ( iopt n . eg . 3) )  then 
cell  1 if i lest  * .prof ',fil#na, ifil) 
if ( ifil .eg. 0)  then 

writet iu, 'tel ) ' ) chert  7) 

cell  kystent t "***  No  dete  files  exist.  Press  'RETURN'  to  cr 
♦eat#  new  file.  •**" ,«1 , out  it , opst ) 

1  ft t opst . eg. 'backup '). or . topst . eq . 'opt ion' ) )  goto  10 
ioptn-2 
goto  20 
end  i  f 
uritet iw,e) 

cell  ky#ntert“f  tie  nuaber" , 0 , 1, real ( if i 1 ), Q ., rnus, opst > 
if t topst .eg. 'option* ) .or. topst .eg. 'backup' ) )  goto  10 
Inus-nlnttrnua) 
end  if 

ift  ifil .eg. 01  lfil-1 

•*•••••••  For  adding  an  env ironaentel  file  the  user  is  put  into 

the  vi  editor.  #••**•#*#***•**#•****•••*•*#**••»*••*•**•*•#•#•* 

ift ioptn, eg. 2)  then 

cell  systest'cp  dprof  dprof') 
call  aystesf *vi  dprof') 
open(3,FIlE-'dprof ’ ) 
reedtS, *  (3<a80/) ,#90) *  )  t due ,1-1 .4) 
reedt3, ’ !a14l ' >  filenatifil) 
closet  3) 

cell  systest'av  dprof  .prof/*//f ilenat if  11 >//char(0> ) 
elee  ift ioptn. eg. 1 >  then 

cell  systeat'ra  .prof/'//fi lenet inua) //chert 0) > 

else 

cell  sytteat'vi  .prof/V/f  i  lenet  inua)//chert0) ) 
open t 3, FILE-' , prof/'//f i lenet inus) ) 
read(3, ' (3(e80/) ,e60) ' >tdua, 1-1,4) 
reedt  3, ' <  #14 ) ' )duaneae 

If t duanaae. ne . f i lenet i nua) )  cell  systeat 'av  .prof/' //f i lena 
♦  (inua)//'  prof/'//duanaae//char( 0 ) ) 

cloee(3> 
end  if 
return 
end 
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************************  SUBROUTINE  INITIAL  ********************* 

Purpose '■  This  subroutine  calculates  all  tha  nacaaaary  constants 
and  arrays  for  usa  in  actual  ray  trace  calculations. 


5 

6 

7 

8 
9 

1  0 
1 1 
IS 

13 

14 

15 

16 

17 

18 
19 
£0 
21 
£2 
23 
£4 

25 

26 
27 


Glossary: 

rplot 

irplot 

forbid 

duct 

check 

rl 

rf irst 
ru 

rlast 

ainc 

alpha 

rinc 


Real  value  of  the  number  of  rays  to  be  plotted. 
Integer  value  of  the  number  of  rays  to  be  plotted. 
Angular  region  of  unallowable  ray  traces. 

Flag  indicating  if  the  transmitter  height  is  at 
a  breakpoint. 

Flag  indicating  if  hmax  is  equal  to  any  of  the 
heights  in  the  profile. 


in  arad. 
in  rad. 
in  arad. 
in  rad. 

Incremental  angle  value  for  alpha  array. 
Array  containing  all  initial  launch  angles. 
Range  increment . 


Lower  elevation  angle 
Lower  elevation  angle 
Upper  elevation  angle 
Upper  elevation  angle 


rmetperdot  Heters  per  dot  on  screen. 


subroutine  init i al t rl , ru, irplot .duct , forbid) 
♦INCLUDE  'errvar* 

logical  duct. check 


28:  c 

29 :e  ••***••••••••  Convert  lower  and  upper  angles  to  radians  and  store  In 

30 ;c  an  array  in  incremental  values  corresponding  to  the  number  of  rays  t 
31 :c  by  plotted.  a******************************************************* 

32  c 


33: 

34 

35  : 

36 
37; 
38: 
39- 
40. 
41  : 
42: 

43  c 

44  :  C 
4S-.C 

46  :c 

47 

48 
49: 
SO: 

51  : 

52  : 
S3: 

54  : 

55 
56: 


rf irat*rl*t . e-3 
rlast-ru*1 .e-3 

ainc-t rlast-rf irst )/( irplot-1  ) 
ang!e( 1 )-rf irst 
do  i*2. irplot 

angle( i 1-anglet i-1 >*ainc 
end  do 

angle( irplot ) -rlast 
r lnc-rmai/50 . 
sor- . 025*raax 

•*••*•••*•*•0  Convert  height  ahd  index  erray  to  aeters  and  m-units 
i f  necessary .  •*••<•*••••••#•*•**•••*••#*•••*••*•*••#••••••**•**•• 

do  i-1 , t 1 vl 

if (hun  eq . 'F*  1  then 
h< 1 >-orht  1 1/3.280839 

else 

hti )-orh( i 1 
end  if 

if treun.eq. 'N' )  then 
at i )«ora( 1 1/6.371 
else 

at  1 )-orat i  1 
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57: 

58: 

59: 

60  :  C 

61  :  C 

62  :c 

63  :c 
64: 
65: 
66: 
67: 
68: 
69:C 

70  :c 

71  :  C 

72  ;c 

73  C 
74: 
75: 
76: 
77  : 
78: 
79  : 
80: 
81  : 

82  c 

83  c 

84  :  c 
85: 
86: 
87. 
88: 

89 

90 

91 
92. 

93 

94  : 
95. 

96  c 

97  c 

98  :  c 

99  c 
*00: 
to* 
102: 
103 
*04: 

1  05: 
*06: 

I  07  c 
*  O0:c 
1  09  :  C 
110: 
1*1 
I  *2: 


end  if 
end  do 
nlvl-itvl 

*************  if  the  first  height  level  is  not  0.  then  an  extrapola¬ 
tion  is  don#  to  find  the  a-unit  value  at  the  surface.  ************** 

if (h( 1 ) . ne. 0  . )  th#n 
nlvl-nlvl+1 

surf«h< 1 )/(h(2)-h( *))♦<■( t )-»(£)) 

«( nlvl )-a( 1 )+surf 
end  i  f 

**********  Each  height  level  is  checked  to  see  if  it  matches  the 
maxinua  height.  If  not,  then  the  aaxinum  height  is  included  in  the 
array  and  the  a-unit  value  at  that  height  is  found.  ************** 

check- .false . 
do  i»1 ,  i  1  vl 

if((h(i).le. haax+1 . e-5) . and . (h( i ) . ge . haax-t . e-5) )  check- .true . 
end  do 

if ( . not . check )  then 
nlvl-nlvl+1 
Mnlvll-haax 
end  if 


••*•***•**•••**••  the  array  is  sorted. 

do  10  i»1 ,nlvl-1 
do  20  J-i  +  1 , nlvl 

ifthtJl.gt.hCl))  goto  SO 
dga-h( 1 ) 
h( i )-ht  J ) 
h( J  )«dus 
duaa-a  1 1 > 
a(i >-•( J* 
a( j )-duaa 
20  end  do 

1  0  end  do 


•*••**•*••*  If  MHAX  is  between  two  height  levels  then  the  s-unit 
value  is  found  at  HNAX .  •***♦**••••••#•••*•»#♦•**••*••*••••*•**# 

i? Ihaaa  ne.Mnlvl )  )  thsn 
do  1-1, nlvl 

if  the J ) .eo. haaa >  then 

bex-«h(  j  )-h(  j-t  I  »/th(  j*i  J)*tsf  j*l  )-a<j-D) 

»<  J )*at j-1 )*bet 
end  i  f 
end  do 

••**•*•  The  gradient  at  each  level  is  calculated  and  stored.  •••••• 

else 

rint-(h<nlvl)-h(nlvl-1 > )/(h(nlvl-1)-h(nlvl-2) >e(a(nlvl**1 1- 

♦  at nlvl -2 )  > 
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113=  «(nlvl )*a(nlvl-1 )+rint 

114:  end  if 

115:  do  i*1 , nlvl-1 

116;  dadh( i )*(*( i+1 )-»(i) )/(h(i+1 )-h< i >)♦! .#-3 

117:  if  ( ABS(disdh(  i ) ) . It . 1 e-6 )  dadhtn-l.e-6 

118:  end  do 

119:  rmetperdot*r®ax/390 . 

1  20  :  C 

121 : c  **************  The  transmitter  height  is  checked  to  see  if  it  it 
1 22 : c  at  a  breakpoint.  If  so,  the  unallowable  angular  range  is 
1 23 :c  calculated,  a*************************************************** 
1  24 :  c 

125:  forbid-0. 

126:  duct*. false. 

127-.  do  i*1  , nlvl 

128:  if ( (h< i ) . le . ht +1 . e-6 > .and . (h< 1 ) . ge . ht-1 . e-6 ) )  then 

129:  if  Udadhl  i-1 )  .gt .  0. )  .and.  (d»dh(  i) .  It  .0  .  ))  forbid* 

130  ♦  SORT (-2 . e-3*dadh( i )*raetperdot ) 

131:  end  i f 

132:  end  do 

133:  if ( forbid. ne. 0 . )  duct*. true. 

134:  return 

1 35 •  end 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 
£5 
26 

27 

28 
£9 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 
52: 

53 

54 

55 

56 


*************4******  SUBROUTINE  INTERPOL  ************************* 

Purpose:  This  subroutine  checks  if  •  transition  fro*  on*  color 

to  the  next  has  been  reached. 

a************************************************* ***************** 

subroutine  interpol ( dif_2, rng_2,hp_2,rng, hyt , hs_£) 

(INCLUDE  'errvar' 

save  dif_1 ,  rng„1 ,hp_1 ,hs_1 
if(frst)  then 
di f_1 «di f_2 
rng_l *rng_2 
hp_1 “hp_2 
h»_1 *hs_2 
goto  10 
end  i  f 

if ( (err opt .  *q. 'a' ) . or . (err opt . *q . ' A ' ) )  then 

i f ( ( ( d i f _ 1 . 1* . aber ) . and . ( di f_£. gt . abtr ) ) . or . ( (di f„2 . la . aber) 

♦  .and. ( d i f 1 .gt .aber) ) )  then 

call  int (di f_1 , di f_2, rng_1 . rng_2, hp_1 . hp_2 irng, hyt , aber) 
els*  if ( l (di f_1 . le .2. *aber ) .and. (dif_2 . gt .2. *ab#r ) ) .or . 

♦  ( (di f_2 . le . 2 . *ab*r ) . and. (di f_1 .gt .2 . *ab*r) ) )  then 

call  int(dif_1 ,dif_2,mg_1 <rng_2,hp„1 #hp_2,rng, hyt , 2. saber ) 
else  if ( ( (dif„1 , le. 3. saber) .and. (dif.,8  .  gt .3. *ab#r) ) .or . 

♦  ( (dif_2. le . 3. saber > . and . (di f_1 .gt .3 . *ab*r ) ) )  then 

call  int(dif.J  . dif_2,rng_l *rng_2,hp_1 .hp^H.rng^yt^S.saber) 
else  if(  <  <dif,„l .  le,4.*aber)  .and.  (dif_2.gt  .4.  saber) )  .or. 

♦  ( (di f_2. le .4 . *aber ) . and . (di f_1 . gt .4 . *aber ) ) )  then 

call  int(dif_1 » dif„2 , rng^l .rng„2,hp_1 , hp_2. rng, hyt , 4 . saber) 
else  if( ( (dif„1 , l e. 5. saber) .and. (difJ2.gt  .5. saber) ) .or. 

♦  ( ( di f_2 . le. 5 . saber ) . and . (di f_1gt . 5 . saber > ) )  then 

call  int  (dif_1  ,  di  f_2,  rng.,.1  »rng_2#hp_1  ,hp„2,rng,  hyt  ,5.  *aber) 
else  if ( ( (di f„1 . le . 6 .saber ) .and . (dif _2 . gt . 6 . saber) ) .or . 

♦  ( ( di f_ 2. le . 6 . saber ) . and . < di f_1 .gt . 6 . *aber ) ) )  then 

call  int  (dif.1 ,  dif_2,  rng.,1 ,  rng^E ,  hp_1  >hp„2,rng,hyt ,  6 .  saber) 
end  if 

else  if ( ( erropt . eq. 'p' ) . or . (erropt . eq . 'P* ) )  then 
1  f  ( ( hs_l  .  eq.  0 .  ) .  or .  (hs.,,2 . eq.  0 .  ) )  then 

hs_l»1 . 

hs_2* 1 . 
end  if 

parcel  ■(dif.J/h*(-1  )*100. 
p*rc_2« ( d i f  J2/h*  J2 ) * 1 0  0 . 

i f ( ( <pere_i . le .per) . and . (perc_ 8 . gt .per) ) . or . ( (perc„2. le.per) 

♦  .and. (perc_i .gt .per) >)  then 


> 1  ‘V*  *  K"r •  '  •  intn 

call  lnt(perc_1 #perc_2, rng_1 ,rng_2,hp_l .hp^a, rng.hyt ,  per) 
»lse  if  ( ( (perc_1  .  le  .  2 ,  *per ) . and .  (p*rc„2  . gt  . 2  .  »per ) )  .or  . 

;  (perc.,2. le . 2. sper) . and. (parcel . gt . £. spar ) ) )  then 


•  ’  P*1  9  .  SIIU  •  ipri  .^1  H  IIITU 

call  int (pere_1 ,perc_2, rng.J ,  rng_2, hp_1  ,hp_2, rng.hyt  ,2 
else  if ( ( (parcel . 1*. 3. sper) .and. (perc_2.gt .3. spar) ) .or. 

( tperc_2 . le .3 . sper) . and . (parcel . gt . 3. sper ) ) )  then 

call  int (perc_1 . perc_2, rng_1 , rng_2, hp_1 .hp_2,rng,hyt , 3. 
else  i f ( \ (parcel  . le . 4 . sper ) . and . (p*rc_2 . gt . 4 . sper ) ) . or . 

( (perc.,2 .  l* .  4 .  sper ) .  and .  (p*rc—1  .  gt .  4 .  sper ) ) )  then 


sper) 


•per) 
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57: 

58; 

59: 

60; 

61  : 

62: 

63: 

64: 

65: 

66: 

67: 

63: 

69: 

70;  10 

71  : 

72  :c 
73 :  c 

74  :e 

75  :c 
76:c 

77  :c 

78  :C 

79  :C 
80: 

81  : 

82: 

83: 

84: 

85: 

86; 


call  int (perc_1 , perc_ 2, rng_1 , rng_£,  hp_1 (hp,_2# rng.hyt , 4 . *per ) 
else  ifl  ( (perc_1 . 1* . 5 . *per ) . and. <perc__2.  gt .5 . *per) ) .or. 

♦  ( lperc_2 .  la . 5 .  >i=per )  .and .  t perc_1  . gt .  5 .*per ) ) )  then 

call  int(perc_1 » perc_2, rng_1 jrng_2.hp._1 .hp_2.rng,hyt,S.*per> 
tltt  if ( ( ( perc_1  . la. 6 . *per ) . and. (perc_2. gt .6 . *per ) ) .or . 

♦  ( (perc_2. la . 6 . *per) . and . ( perc_1 . gt . 6 . *per) ) )  than 

call  int (perc_1 ,  perc_2. rng_1 ,  rng_2, hp_1 ,hp_ 2, rng.hyt , 6 . *par ) 
and  i  f 
and  if 
dif_1»dif_2 
rng_1»rng_2 

hp_1 “hp_2 
h«_1  ■*hs_2 
return 
and 


«*«»*****•****»«*«*  SUBROUTINE  INT  •*•******•••**♦*••*•«**•**• 

Purpose-  Thia  cubroutina  interpclataa  the  transition  froa  ona 
height  error  increment  (color)  to  the  neat . 


subroutine  int(du*_1 , du»_2« rng_1  .rng_2,hp_1 , hp_8, rng, hy t  .fxdif ) 

rin«(f xdif-dua_1 )/(dua_2-dua_1 > •(rng_2-rng_1 ) 

rng«rng_ierin 

hin-(rng-rng_1  )/<rng_2-rng_1 >*(hp_2-hp_1 ) 

hyt-hp_1*hin 

return 

and 
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i 

S' 

1! 


1  !C 
2 :  c 
3  c 

4 :  C 

5  :  C 

6  :  C 
7 :  C 
8  :  C 
9 :  C 

I  0  :  C 

II  :C 
12c 
13.  c 
1  4 :  C 
15:  C 
16: 

17: 

18: 

19: 

£0: 

21  : 

22: 

23: 

£4: 

25: 

26:  10 
27: 

28: 

29: 

30: 

31  : 

32- 

33 

34: 

35: 

36 

37 

38 

39 


*********  Subroutine  LSFILES  produces  a  two-column  list,  preceded 
by  a  number,  of  all  data  files  stored  in  directory  'DIR'. 

The  maximum  number  of  data  files  46.  **************************** 

***************************************************************** 

Glossary : 

if i i  Counter  for  number  of  files  in  directory.  Uill  be 
zero  if  no  files  in  that  directory, 
ire  One-half  of  ifil  to  print  out  on  screen  a  two-column 
list  of  filenames 

name  46  element  array  -  stores  filenames 

••************«**************************************** ********** 

subroutine  isf t lest  dir, name, ifil) 
character*14  n»me(46) 
character^*)  dir 

call  syttemt'ls  ' //dir//'  >Qdataf  i  les® '//chart  0) ) 
opent 1 , FlLE«'$dataf lies®' ) 
ifil»0 
do  #  46 

readd  .  '  ( a  1 4 ) ' , END*  1 0 ) name  t ) ) 
lfil*iftle1 
end  do 
continue 
closet  1 ) 

ir#*nlnt ( i f l 1/2 . ) 
do  J«l,ire 

if ( (modi  if U , 2) . ne, 0 > . and . ( j .  eq . ire) )  then 
writei 6 . ' ( I2,3r,a14) ' ) J ,na*e( J) 

else 

writeto. ' t i£,3*,al4, lOx, i2.3x.a14) ' ) j .namel j ) , j*ire, 

♦  nametjeire) 
end  i  f 
end  do 

call  «y»tem('rm  ®dataf ile*®‘ ) 

return 

end 
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1  :c 

2  c 

3 :  C 

4:C 

5  :  C 

6  :  C 
7 :  C 

8  :  C 

9  :  C 

I  0  :  C 

II  :C 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
£1  : 
22: 
£3: 
24: 
£5: 
26: 
27: 
28: 
29: 
30: 
31  : 
32: 

33 

34 

35 

36 
37: 
38 
39. 
40: 
41  : 
42: 
43: 
44  : 
45: 
46: 
47: 
48 
49. 

50 

51  : 
52: 
S3: 
S4: 

55 

56  : 


***********************  SUBROUTINE  PUTIN  *e*e**e**********e****** 

Purpose :  This  subroutine  puts  in  all  user  inforsation  into  a  fila 
for  latsr  retrieval.  This  allows  the  user  to  run  a 
second  display  for  the  saae  profile  (with  ainor 
changes  if  so  desired)  without  going 
through  each  prospt  again. 


subrout ine  put in( rl ,ru, irpiot , f i lvar, fun) 
include  'errvar' 
character^  fun 
opeo(  2. FIL£*'usin* ) 

if( (err opt . eq. *a* ) . or. lerropt . eq. *A' ) )  then 
f i 1 var*aber 
else 

f i lvar«per 


end  If 

call  kyreadcT.fun) 

write (2, * (2S«4“e*  USER  INPUT  PARAMETERS  •♦’>*) 
urite(2>«) 

writetS.  *  (S* ,  “You  are  now  in  ‘’vi**.  if  there  are  any  changes'*, 

♦  “  desired  use  ‘‘vi**  coas ends'*  >  * ) 

wri  t •( 2, * ( 5* . "f or  editing.  Eiit  by  typing  * *22** .“)* ) 

wrtte(2,e) 

write(2,») 

if ( fun. eq.  'fps' )  then 

writeta, * ( f7 . 0, 1 0* , * 5  Ha*l*ua  height  for  display  in  feet*)*) 

♦  hea**3 . 280839 

wrjte(2. ' ( f4 . 0, 1 3* , * |  Masisus  range  for  display  in  n**)') 

♦  rsa*/1. 85318 

writeta, * i f6 . 0, 1 1  * , * |  Antenna  height  in  feet" >* >M *3 .280839 

else 

writelfi,  *  (  f7 . 0, 1 0*  ,  *  |  Itaaiaua  height  fer  display  in  aeter#**)*) 

♦  haa* 

wr  lt*(2,  '  ( f4 . 0,  13*  ,  *  I  Nasiaua  range  for  display  in  Its")') 

♦  ra** 

wr i t e1 2. *  (  f6 . 0, 1 3e. "  |  Antenna  height  in  attars* ) ' >ht 


end  if 

wri te( 2, ' ( fS . 0, 12* , ’ |  Lower  elevation  angle  (arad)’)*>rl 
wri te(2. *  4 fS . 0. 13a • *|  Upper  elevation  angle  (arad)*)')ru 
wri t#(2, * ( i4 , 13a , * f  Nuaber  of  rays  to  be  plotted  (integer)’)') 
♦irpiot 

wri tt(2, ' ( at , 16* , * |  A  or  P  —  Abaoluta  or  Percent  error* )' )erropt 
wr ite(S. * ( i t , 16*. * j  1  -  graph  ;  2  -  nusbers  :  for  profile  printout 

♦  ( Integer  )*)*)  ipro_j>rlnt 
write(2,*) 

write(2, * ( 10s,’e»*  Fill  in  only  the  line  that  applies  •••*)*) 
write(2.*) 

if ( ( erropt . eq. ' a ' ) . or . lerropt . eq. *  A' ) )  then 
if ( fun . eq . * fps’ )  then 

wri te ( 2, * ( fS  C , 12* , ’ I  Error  increment  in  feet’)*) 

♦  filvarO.  280839 

else 
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57: 

58: 

59  : 

60  : 

61  : 
62: 
63: 
64: 
65: 
66  : 
67- 

68  :c 

69  :c 

70  :  C 

71  :C 
<  £  :  C 
73:C 

74  -  c 

75  :c 

76  ■■ 
77: 
78: 

79  -• 

80  : 
81  : 
82: 
83: 
84: 
85: 
86  : 
87  : 
88'- 

89  : 

90  : 

91 
9£  : 

93  : 

94  : 
95: 

96  : 

97  : 

98  ■■ 

99  ' 

1  00: 
t  01  ; 

1  02: 

1  03: 

1  04  : 

1  05: 

1  06  : 

1  07: 

1  08  : 

1  09  : 
110: 


write(2, ' (fS.O, 12x, " l  Error  increment  in  meters" )') f i lvar 
end  if 

write(2, ' ( 1 7x, "  |  Percent  error  increment")') 
else  if< (erropt .eq. 'p' ) .or. (erropt .eq. 'P' ) )  then 
write(2, ' ( 17x, " |  Error  increment")') 

write(£, ' ( f3 . 0 , 14x , " |  Percent  error  increment ")') fi War 
end  i  f 
close(2) 

call'  rdf fl <  rl , ru, irplot , f i 1 var , fun) 

return 

end 

**********************  SUBROUTINE  SDFFL  *****************«>*****< 

Purpose:  This  subroutine  reads  all  user  input  parameters  from  t 

file. 

***************************************************************> 

subroutine  rdf  f  1  < rl ,  ru,  irplot ,  f  i  War ,  fun) 
include  'errvar' 
character*3  fun 
character*80  dum 
call  system< 'vi  usin') 
open(2,FILE  «  'usin') 
read(H,  '  ( 5<  #80/ ) ,  a80  )  '  Mdum,i«1 ,6) 
read( 2, ' C ( f 7 . 0/ ) , ( f 4 . 0/ ) , f 6 . 0 > ' )hmax , rmax , ht 
read(2, ' <2< f5. 0/> , i i4/) , (al /), i 1) ' )rl ,ry, irplot .erropt , 
+ipro_prinx 
if  (  fun.eq. ' fps' )then 
hmax“hmax/3 . 280839 
rmax*rmax*1 . 85318 
ht»ht/3. 280839 
end  i  f 

read (2  ' ( 2( a80/ ) , a80 ) ' ) C dum , i»1 . 3 ) 
i f  < (erropt .eq,'a').or,( erropt . eq . ' A' ) )  then 
r*ad(2,  '  (  f5. 0) '  >f  i  War 
aber»f  i  War 

i f  <  f un . eq . ' f pa  * )  aber«aber/3 .280839 
else  if < (erropt ,tq. 'p' ) .or. (erropt .eq. *P* ) )  then 
reed(2,  '  ( (a80/ ) , f5 . 0  > '  )dum,  f  i  War 
per*=f  i  War 
end  i  f 
close(S) 
do  j  =  1 1 35 
h(j)r0. 
m( j )»0 . 
dmdh( j )«0  . 
end  do 
do  j«l , 300 
angle( J  >«0 . 
end  do 
return 
end 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

1  0 
1  1 
12 
;3 

14 

15 

16 

17 

18 
1  9 
£0 
21 
22 
23 
£4 
25 
£6 
27 
£8 

29 

30 

31 

32 

33 

34 

35 

36 
3? 

38 

39 

40 

41 


*********************  SUBROUTINE  READOA  it*************************** 

Purpose:  Subroutine  READDA  reeds  environmental  date  from  date 
files  the  user  specifies. 

Glossary  = 
profile 
ipick 


Character  array  containing  environmental  data 
filenames. 

Counter  for  "profile"  array  indicating  number 
of  environmental  data  file. 


** *********** **************** ****************************** ********* 


subrout ine  readdal ipick , profile) 
♦INCLUDE  ' errvar ' 

character*14  profile(50) 
character*®©  dum 


******************  Open  data  file;  read  data  ********************** 

opent t 0 , FILE** . prof /' //prof i le( ipick )} 

read(  10, '  (3(a80/)4a80) '  Hdum,  i®1  ,4) 

read(  I0,‘((a14/},(a1/>,a1)'  )pr  of  lie  (Ipick )  ,hun<.  reun 

read( l 0 , ' ( 4 (#80/ ) ,»60 ) * ) Cdum, i»l ,5) 

i lvl»0 

***«**•**••»•***«****  Read  H  and  H  arrays.  e*»****e**e***#a**e****** 

do  i=>1 , 33 

iflreun.eq. 'H' )  then 

readUO,  '(f7. 1 ,5* , f 6 . 1  )  %  END*!  0  >orh(  i  > }  or»(  i  ) 
else 

read! 1 0 . • ( f 7 . 1 , 1 ®x , f 6 . 1) * , END*! 6  >orh( i 1 4 eraii ) 
end  if 
i  1  v  1  •  i  1  v  1  ♦  1 
end  do 

10  continue 
close(lO) 
return 
end 
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1 

e 

3 

4 

5 

6 

7 

8 
9 

1  0 
1  1 
IS 

13 

14 

15 

16 

17 

18 
1  9 
SO 
21 
22 

23 

24 

25 
£6 
27 
£8 

29 

30 

31 
38 

33 

34 

35 

36 

37 

38 

39 

40 

41 
48 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 


*************************  SUBROUTINE  REGULAR  *********************** 

Purpose:  This  begins  the  main  calculations  of  the  program.  It 

does  not  allow  rays  to  be  traced  within  an  angular  limit 
if  the  transmitter  height  is  at  a  break  point. 

Glossary : 

duct  Logical  flag  indicating  if  the  transmitter  height  is 
at  a  break  point. 

irplot  Number  of  rays  to  be  plotted, 

alpha  Beginning  angle. 

fixang  Initial  elevation  angle  currently  being  used. 

ij  Counter. 

hbef  Beginning  height. 

rbef  Beginning  range. 

forbid  Rays  are  not  traced  in  this  angular  range. 


******************************************************* ************ 

subroutine  regular! irays,duct , forbid, ix ) 
include  '/usr/ include/s tar base . f2.h ' 
include  ' /usr/include/st arbase . fl . h ' 

•  INCLUDE  ' errvar  * 
logical  duct 


Begin  main  loop. 


do  ik«1,iray§ 
frst" . true . 

i f (plot ) f rsti»e«. true, 
if ( tn.ne. 1 )  then 
nvf  1« . false  . 
else 

if(plot)  then 
mvf 1» . true. 

else 

if <f7.eq. 'fps'  )  then 

cell  noveSdi fi ides, 0 . ,ht*3. £808391 

else 

call  move2di f i Ides, 0 . ,ht ) 
end  if 
end  if 
end  i  f 


Initialize  variables  for  ray  tracing. 


if(plot)  call  start(ik,ix) 

*lpha«angle( ik 1 
f 1 *ang«angie( ik  > 
i  j-ix 

hbef »ht 
rbef"0 . 

•••••••••*«  check  if  transmitter  is  at  a  breakpoint.  If  so,  skip 

angles  within  forbidden  range.  ••••••*•••••*•••••••***••*•••••••• 
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57 

58 

59 

60 
61 
6E 

63 

64 

65 

66 

67 

68 
69 


if (duct)  then 

i f(ABS( alpha) . le . forbid)  then 
rp»rmax 

call  Iine_color_index( fildes, 1 ) 
if ( f 7 . eq . ' fps ' )  then 

call  drawSdt f i Idea , rp* . 53961 1 7 , ht *3 . 880839 ) 
else 

call  draw2d(f iides,rp,ht ) 
end  if 
goto  50 
end  If 
end  if 


70 

71 
7£ 

73 

74 

75 


***********  If  initial  elevation  angle  is  negative  then  call  routine 
for  down-going  rays.  If  it  is  positive,  then  call  routine  for  up- 
going  rays.  If  it  is  0  then  call  routine  to  check  on  the  value  of 
the  gradient .  ***********>***********««***«•*******«****•********•*** 


76 

77 

78 

79 
SO 
81 
82 
S3 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 


30 


50 


if (alpha. eq. 0. )  then 

call  2ero(alpha,hbef,iJ,rb*f ,rp,hp, f ixang) 
else  i f (alpha . gt . 0 . )  then 

call  up(alpha,hb*f , i j ,rbef  rp,hp, ? ixang) 

else 

call  down(alphe,hbef , i j , rbef , rp,hp, f ixang) 
end  if 

if (hp, eq.ht 1 ) )  goto  50 
if  ( (rp.  It .  reax)  .and.  thp.  It  .hmass)  t  goto  30 
continue 
end  do 
return 
end 

*»****«#***********t(.»*«e  -  SUBROUTINE  SEVEN  e*e *•#**•*#•« a* eeaeaee* 

Purpose;  This  rout int  performs  the  ray-tracing  procedure  7  times 
(once  for  each  color)  for  ease  in  plotting  onto  the 
graphics  plotter. 

e*  *••**•***  #****  **********  ••*♦•*•*•**••*•••#•**•* 


98 

99 
100 
101 
102 
1  03 
1  04 
1  05 
106 


subrout ine  sevent i rays, duct .forbid, i x ) 
•INCLUDE  'errvar' 
logical  duct 
do  its*1 ,7 

•vfl«.truo. 

cal  1  regular! irays.duct. forbid, ix) 
end  do 
return 
end 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 

16 

17 

18 
19 


**********************  SUBROUTINE  STEPFIXSCR  *********************** 

Purpose:  STEPFIXSCR  defines  the  color  scale  for  plotting  height 
and  range  onto  the  screen  in  the  correct  color. 

Glossary ; 

percerr  Percentage  error  between  height  of  non-standard 
atmosphere  ray  and  height  of  standard  atmosphere 
ray . 

rng  Interpolated  range  between  color  transitions, 
hyt  Interpolated  height  between  color  transitions. 

******************************************************************** 


subroutine  stepf ixscr (hdi f ,hs , rp,hp, rng.hyt ) 
include  '/usr/inelude/starbasc . f 1. h' 
include  '/usr/include/starbase. ffi.h* 

(INCLUDE  'errwar* 


£0 

21 

E2 

23 

£4 


25 

26 

27 

28 
29 


30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 


45 

46 

47 
46 


49 

50 

51 

52 

53 

54 

55 

56 


if ( rng . ne . 0 . )  then 

i f ( f7 . eq. *  fps  * )  then 

call  draw2d( f tides* rng/1 . 8531 8, hyt *3 . £80839 ) 

else 

call  draw£d( f ildeti rng.hyt ) 
end  if 
end  if 

*•***•••**•*  Define  color  scale  for  absolute  height  error. 

if ( (err opt . eq. *a* ) .or . (trropt .eq. 'A* ) )  then 
if(hdif . le.eber)  then 

call  line^color^indext  Hides.  1  > 
else  i f ( (hdi f .gt . aber) .and. (hdi f > le .2 . *aber ) )  then 
call  l ine^color^index ( f tides, 3) 
else  i f ( (hdi f .gt ,2 . *ab*r ) . and . (hdi f . ie.3 . *aber ) )  then 
call  linewcolorwindex(fildes,4) 
els*  i f t (hdi f . gt ,3 . *tber > , and. (hdi f . le . 4 . *eber > )  then 
call  1 ine^color^indext f tides, 5) 
else  i f ( (hdi F . gt . 4 . *aber ) . ana . (hdi f . 1* .5. **b»r ))  then 
call  1 ine_color_ind#x( f i ld*s.6> 
els*  i f ( ( hdi f . gt .5 . •aber ) . and. (hdi f . 1* . 6 . *aber ) )  then 
call  line^color^indexifildes,?) 
els*  i f (hdi f . gt . 6 . «ab*r )  then 

call  lin#_color_lnd#x<flldes,£> 
end  If 

*»•••••••#•  Define  color  scale  for  percentage  height  error. 

els*  i f t (erropt . eq . *p *  1 . or . (erropt . eq . 'P ' ) )  then 
if ‘hs . eq . 1 . )  then 
p#rc*rr“200. 

ele* 

p*rc*rr*thdi f/h*)*1 00 . 
end  ir 

if (percerr. 1*. per )  then 

call  1  ine_color_ index ( f 1  Ides , 1 > 
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57:  tlst  if ( (parcarr . gt . par) . and . (parcarr. It . 8. *par) )  than 

58:  call  1 ina_color_index ( f i Idas. 3) 

59:  alsa  if ( (parcarr. gt . 2.*par) .and. (parcarr. la.3.*par) )  than 

60:  call  lina_color_indax(f ildas,4) 

61;  ala#  if ( (parcarr . gt . 3 . *par) . and . (parcarr. la. A . *par) )  than 

62 :  call  lina_color_indax(f ildas,5) 

63:  alsa  i f( (parcarr . gt . 4 . *par) . and. (parcarr . la . 5 . *par ) )  than 

64:  call  lina_color_indax ( f i Idas, 6) 

65;  alsa  i f( (parcarr . gt . 5. *par) . and. (parcarr. la. 6 . apar) )  than 

66:  call  lina_color_indax( f ildas. 7) 

67:  alsa  if (parcarr. gt .6 .*por)  than 

68:  call  lina  color  indax ( f i Idas, £) 

69:  and  if 

70:  and  if 

71  :  if (f7.aq. 'fps* )  than 

72:  call  draw£d( f 1 Idas, rp/1 . 8531 8,hp*3 . £80839 ) 

73;  alsa 

74:  call  draw2d( f ildas.rp.hp ) 

75.  and  if 

76:  raturn  • 

77:  and 

78  c 

79  C  •*•••***•♦*•*****•**♦  SUBROUTINE  RENEW  •*••••****•••**•*••** 

80 -c 

81 :c  Purposa:  RENEW  ra-init ial izas  arrays  usad  in  ray  tracing. 

82  c 

83 :c  **•••♦** **»**#*** •••*«****•**♦*•***•*•••*•*••*••••*••*••#**•• 

84  :c 

85:  subrout int  ranaw 

86 : 41NCLUDE  ‘arrvar' 

87:  do  j*1 .35 

88:  d«dh(j)»Q. 

89:  h()J«0, 

90: 

91 •  and  do 

92:  do  j -1 .33 

93 :  orht  J )«0 . 

94.  or»(j)-0. 

95 ;  and  do 

96.  do  j-1 *  300 

97  anglatjJ-0. 

98:  and  do 

99:  raturn 

100:  and 
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1 : c  **************e***********  SUBROUTINE  UP  **************************** 
S :  c 

3:c  Purpose1-  This  subroutine  perforss  a  ray  trace  for  up-going  rays. 

4 :  c 

5 ;  c  ******************** ************************************************* 
6 :  c 

7:  subroutine  up(alpha,hbef , i j ,rbef ,rp,hp , f i xang) 

8:  include  ' /usr/include/starbase . f 1 . h * 

9:  include  ‘/usr/include/starbase. fS.h' 

1 0 : $ INCLUDE  * errvar ' 

11  :c 

1 2 : c  **********  Begin  at  transmitter  height  and  calculate  until  the  ray 
1 3 c  reaches  a  maximum  or  maximum  height.  ***************************** 

1 4 :  c 

15:  do  whi le( ( i j . It . nlvl ). and . (alpha .ge. 0 .) ) 

16;  rp»rbef+rinc 

17:  iftrp.ge.rmax)  goto  20 

18:  alphap«alpha*dmdh( i j )*( rp-rbef ) 

1  9  :  C 

20 : c  •*•*•**•*  If  the  ray  reaches  a  maximum  then  set  ALPHAP  to  0.  and 

21  :c  calculate  height  and  range.  Call  DOWN.  ************************* 

22:  c 

S3  if (alphap. 1*. 0 . )  then 

24:  alphap"Q. 

25;  rp*rbef-alpha/dmdh( 1 j ) 

26:  hp«hb*r-4lphe**2/2.e-3/dmdh< ij> 

27 :  end  i f 

28 :  hp*hbef ♦ ( alphap*  *2-a 1 pha*  *2 ) /2 . e-3/darh ( i j ) 

29 :  if(hpgth(ij*!))  then 

30:  hp*h( i )*1 ) 

31 :  rad«alpha**2*£.e-3*dmdh( 1 J )*<hp-hi>ef) 

32  - c 

33  c  •*•*****•  If  the  ray  reaches  a  maximum  then  set  ALPHAP  to  0.  and 

34 ; c  calculate  height  and  range.  Call  DOUN.  a************************ 

3S :  C 

36;  if (rad. le. 0.  l  then 

37:  alphap*0. 

38  '  rp*rbef-alpha/dmdh( i j ) 

39  hp*hbef-alpha**2/2 , e-3/dmdh( i J ) 

40:  else 

41:  alphapoSORTCred) 

4£;  rp>rbef*(alphap-*lp^a>/dmdh( i j ) 

43:  end  if 

44:  lj»ij*1 

4S  end  if 

46:  if  ( ( rp . ge . rsax ) . or . (hp . ge . hmax > )  goto  10 

47  C 

48  c  *•*••••*•*  Call  STAND  to  determine  height  of  ray  for  standard 

49  c  atmosphere  at  same  range.  ••**•••*••••••**••*•••••*•*••**•••• 

S0;c 

51  call  stand(fixang,r,.  ,hp' 

S2 :  hbef»hp 

53:  rbef»rp 

S4:  alpha-alph*p 

55  i  f  1  alpha . »  j.  0  .  1  goto  10 

56 ;  end  do 


A-27 
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57:  10  if (i j .eq.nlvl)  ij»nlvl-1 

58  :c 

59  :c  ***********  if  ray  is  calculated  psst  the  aaxiaua  height,  then  set 

60 :c  HP  equal  to  HHAX  and  calculate  range  at  exactly  the  aaxiaua  height.  * 
61  :  c 

68:  if (hp . ge .  haax )  then 

63:  hpBhaax 

64:  alphap>SQRT(alpha**£  +  S.e-3*dadh(i j )*1hp-hbef ) ) 

65 :  rp*rbef+(alphap-alpha)/dadh( i j ) 

66:  if (rp.ge.raax)  goto  80 

67:  call  standi fixang,rp,hp) 

68:  end  if 

69 :  C 

70 :c  **********  if  ray  reaches  beyond  aaxiaua  range  then  calculate  height 
71 ; c  at  exactly  aaxiaua  range.  **************************e*************** 

78  :c 

73:  80  if <rp . ge .raax )  then 

74:  rp*raax 

75:  alphep»alpha+dadh( i J )*(rp-rbef ) 

76 :  hp"hbef ♦ ( a lphap**8-a lpha**8 1 /8 . e~3/dadh( i J ) 

77:  call  standi fixsng,rp,hp) 

78:  end  if 

79:  return 

80:  end 
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1  : c  ***********************  SUBROUTINE  ZERO  ***************************** 

2 :  c 

3 : c  Purpose  This  subroutine  determines  which  subroutins  will  be 
4;c  called  when  •  ray  reaches  a  aaxiaua  or  aininua.  If 

S : c  a  ray  reaches  a  itaxiaus,  then  depending  on  the  value 

6--c  of  the  gradient*  DOWN  is  called.  Likewise*  if  a  ray 

7  '■  c  reaches  a  ainiaua*  UP  is  called. 

8 :  C 

9: C  ********************************************************************* 

1  0  :  C 

11:  subroutine  iero(alpha* hbef » i j,rbef ,rp,hp,fi«ang> 

1 2 : (INCLUDE  'errvar' 

13;  if ( dadht i j ) . It . 0. )  then 

14:  call  down< alpha* hbef, i j * rbef , rp,hp* fi xang) 

IS:  else 

16:  call  uptalpha.hbef , ij , rbef ,rp,hp, f ixang) 

17.  end  if 

18.  return 

1 9 :  end 
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